home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / NAP_DRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  10KB  |  300 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 216 of 228
  3. From : Warren Zatwarniski                  1:140/111.0          14 Jul 93  22:45
  4. To   : All
  5. Subj : (1/3) NAP_DRAW.PAS
  6. ────────────────────────────────────────────────────────────────────────────────}
  7. Unit NAP_DRAW;
  8.  
  9. Interface
  10.  
  11. Uses
  12.     Bits, BIN_UNIT ;
  13.  
  14.     Type
  15.         NAPCoord = String;
  16.  
  17. TYPE
  18.    NAPBits = Record                     {Record to hold the 3 seperate parts}
  19.                    P1, P2, P3 : Byte    {of a Byte. P1 contains 2 bits, and }
  20.             end;                        {the P2 & P3 contain 3 bits.        }
  21.    XYType = Record
  22.                 X, Y : Byte
  23.              End;
  24.  
  25.  
  26. Const
  27.      PointSetAbs = Chr(164);
  28.      PointSetRel = Chr(165);
  29.      PointAbs    = Chr(166);
  30.      PointRel    = Chr(167);
  31.  
  32.      SetPolyFill = Chr(183);
  33.      PolyFill    = Chr(181);
  34.  
  35.      LineAbs     = Chr(168);
  36.      LineRel     = Chr(169);
  37.      SetLineAbs  = Chr(170);
  38.      SetLineRel  = Chr(171);
  39.  
  40.      ArcOutline  = Chr(172);
  41.      ArcFilled   = Chr(173);
  42.      SetArcOutline = Chr(174);
  43.      SetArcFilled  = Chr(175);
  44.  
  45.      RectO         = Chr(176);
  46.      RectF         = Chr(177);
  47.      SetRectO      = Chr(178);
  48.      SetRectF      = Chr(179);
  49.  
  50.      NAPSetColor = Chr(188);
  51.  
  52.  
  53. VAR
  54.    XColor : Word;                         {Set to max number of colors}
  55.    LMO    : ShortInt;                     {Length of Multivalue Operands  }
  56.    LSO    : ShortInt;                     {Length of Single-Value Operands}
  57.    PelSize : XYType;
  58.    CharSpace, CharPath, CharRot, CursStyle, MoveAttr, RowSpace : Byte;
  59.  
  60.  
  61.  
  62. Function N_Point (Xcoord, Ycoord : Integer) : String;
  63. Function N_SelectColor (Color : Byte) : String;
  64. Function N_SetColor(Green, Red, Blue : Real) : String;
  65. Function N_Domain : String;
  66. Function N_Reset (Color, Mode : Byte; D, T, F, U, X, M, R : Boolean) : String;
  67. Function N_Text (XSize,YSize : Byte) : String;
  68.  
  69.  
  70. Procedure SeperateBits (Coord : Byte; VAR Pbits : NAPBits);
  71.  
  72.  
  73. Implementation
  74.  
  75. Procedure SeperateBits ( Coord : Byte ;
  76.                         VAR PBits : NAPBits);
  77. Var
  78.    TEMP : Byte;
  79.  
  80. Begin
  81.      With PBits DO
  82.         Begin
  83.            P1 := Coord shr 6;
  84.            P2 := (Coord - (P1 Shl 6)) Shr 3;
  85.            P3 := Coord - ((P1 Shl 6) + (P2 shl 3));
  86.         End;
  87. End;
  88.  
  89. Function N_Point (Xcoord, Ycoord : Integer ) : NAPCoord;
  90. VAR
  91.    Xbits, Ybits : NAPBits;
  92.    XSign, YSign : Byte;
  93. Begin
  94.      XSign := 0;
  95.      YSign := 0;
  96.      If Xcoord < 0 Then                            { Is X Negative? }
  97.         Begin
  98.            Xsign := 1;
  99.            Xcoord := (255 - Abs(Xcoord)) + 1
  100.         end;
  101.      If Ycoord < 0 Then                           { Is Y Negative? }
  102.         Begin
  103.            YSign := 1;
  104.            YCoord := (255 - Abs(YCoord)) + 1
  105.         end;
  106.      SeperateBits(Xcoord, Xbits);
  107.      SeperateBits(Ycoord, Ybits);
  108.      N_Point := Chr( (192) + (XSign SHL 5) + (Xbits.P1 Shl 3) + (YSign SHL 2) +
  109. (Ybits.P1) ) +
  110.                 Chr( (192) + (Xbits.P2 Shl 3) + (Ybits.P2) ) +
  111.                 Chr( (192) + (Xbits.P3 shl 3) + (Ybits.P3) );
  112. End;
  113.  
  114.  
  115. Function N_SelectColor (Color: Byte) : String;
  116.  
  117. VAR
  118.    Temp : String;
  119.    TByte : Byte;
  120. Begin
  121.      Temp := '';
  122.      Temp := Chr(128 + 62);
  123.      IF XColor <= 2 Then
  124.         Temp := Temp + Chr(192 + (Color Shl 5))
  125.         Else If XColor <= 4 Then
  126.            Temp := Temp + Chr(192 + (Color Shl 4))
  127.            Else If Xcolor <= 8 Then
  128.               Temp := Temp + Chr(192 + (Color SHL 3))
  129.               Else IF XColor <= 16 Then
  130.                  Temp := Temp + Chr(192 + (Color SHL 2))
  131.                  Else IF XColor <= 32 Then
  132.                     Temp := Temp + Chr(192 + (Color SHL 1))
  133.                     Else IF Xcolor <= 64 Then
  134.                        Temp := Temp + Chr(192 + Color)
  135.                        Else IF Xcolor <= 128 Then
  136.                           Begin
  137.                              TByte := ( (Color SHR 1) SHL 1);
  138.                              Temp := Temp + Chr(192 + (Color SHR 1) ) ;
  139.                              Temp := Temp + Chr(192 + ( (Color - TByte) SHL 5) 
  140. );
  141.                           End
  142.                           Else
  143.                              Begin
  144.                                 TByte := ( Color SHR 2);
  145.                                 Tbyte := TByte SHL 2 ;
  146.                                 Temp := Temp + Chr(192 + (Color SHR 2) );
  147.                                 Temp := Temp + Chr(192 + ( (Color - Tbyte) SHL 
  148. 4) );
  149.                              End;
  150.      N_SelectColor := Temp
  151. End;
  152.  
  153.  
  154. Function N_SetColor(Green, Red, Blue : Real) : String;
  155.  
  156. VAR
  157.    Loop, Temp : Byte;
  158.    TempReal : Real;
  159.    WorkStr : String;
  160.    IntRed, IntGreen, IntBlue : Integer;
  161.    Dec1Red, Dec2Red, Dec3Red,
  162.    Dec1Green, Dec2Green, Dec3Green,
  163.    Dec1Blue, Dec2Blue, Dec3Blue : Byte;
  164.  
  165. Function MoveOver(WorkWith : Real) : Real;
  166. Begin
  167.      MoveOver := ( (WorkWith * 2) - (Trunc(WorkWith * 2)));
  168. End;
  169.  
  170.  
  171.  
  172. Begin
  173.      IntRed := Trunc(Red);
  174.      IntGreen := Trunc(Green);
  175.      IntBlue := Trunc(Blue);
  176.      TempReal := (Red - IntRed);                {Dec1Red equals the first  }
  177.      Dec1Red := Trunc(TempReal * 2);            {decimal bit in the Red    }
  178.        TempReal := MoveOver(TempReal);          {value                     }
  179.        Dec2Red := Trunc(TempReal * 2);          {Dec2Red is equal to the   }
  180.          TempReal := MoveOver(TempReal);        {Second decimal bit in the }
  181.          Dec3Red := Trunc(TempReal * 2);        {red Value and so on       }
  182.      TempReal := (Green - IntGreen);            {could use some serious    }
  183.      Dec1Green := Trunc(TempReal * 2);          {rewrite here for faster   }
  184.        TempReal := MoveOver(TempReal);          {speed - But this works :> }
  185.        Dec2Green := Trunc(TempReal * 2);
  186.          TempReal := MoveOver(TempReal);
  187.          Dec3Green := Trunc(TempReal * 2);
  188.      TempReal := (Blue - IntBlue);
  189.      Dec1Blue := Trunc(TempReal * 2);
  190.        TempReal := MoveOver(TempReal);
  191.        Dec2Blue := Trunc(TempReal * 2);
  192.          TempReal := MoveOver(TempReal);
  193.          Dec3Blue := Trunc(TempReal * 2);
  194.      WorkStr := '';
  195.      WorkStr := Chr(192+
  196.                            ((IntGreen SHR 2) SHL 5) +
  197.                            ((IntRed   SHR 2) SHL 4) +
  198.                            ((IntBlue  SHR 2) SHL 3) +
  199.                            (((IntGreen - ((IntGreen SHR 2) SHL 2)) SHR 1) SHL
  200. 2) +
  201.                            (((IntRed -   ((IntRed   SHR 2) SHL 2)) SHR 1) SHL
  202. 1) +
  203.                            (( IntBlue -  ((IntBlue  SHR 2) SHL 2)) SHR 1)
  204.                            );
  205.      WorkStr := WorkStr + Chr(192 +
  206.                            ((IntGreen - ((IntGreen SHR 1) SHL 1)) SHL 5) +
  207.                            ((IntRed   - ((IntRed   SHR 1) SHL 1)) SHL 4) +
  208.                            ((IntBlue  - ((IntBlue  SHR 1) SHL 1)) SHL 3) +
  209.                            (Dec1Green SHL 2) +
  210.                            (Dec1Red   SHL 1) +
  211.                            (Dec1Blue       )
  212.                           );
  213.      WorkStr := WorkStr + Chr(192 +
  214.                            (Dec2Green SHL 5) +
  215.                            (Dec2Red   SHL 4) +
  216.                            (Dec2Blue  SHL 3) +
  217.                            (Dec3Green SHL 2) +
  218.                            (Dec3Red   SHL 1) +
  219.                            (Dec3Blue       )
  220.                           );
  221.      N_SetColor := WorkStr
  222. End;
  223.  
  224. Function N_Domain : String;
  225. VAR
  226.    TempS : String;
  227.    TempX, TempY : Byte ;
  228.    XBits, YBits : NAPBits;
  229.  
  230. Begin
  231.      TempS := Chr(161)+Chr(192+( (LMO - 1) SHL 2) + (LSO - 1) );
  232.      Case LMO of
  233.           1 : TempS := TempS + Chr(192 + (PelSize.X SHL 3) + (PelSize.Y));
  234.           2 : Begin
  235.                  TempX := (PelSize.X SHR 3) ;
  236.                  TempY := (PelSize.Y SHR 3) ;
  237.                  TempS := TempS + Chr(192 + (TempX SHL 3) + TempY) ;
  238.                  TempS := TempS + Chr(192 +
  239.                                      ( ( (TempX SHL 3) - PelSize.X) SHL 3) +
  240.                                      ( ( (TempY SHL 3) - PelSize.Y) ) )
  241.               End;
  242.           3 : Begin
  243.                  SeperateBits(PelSize.X, Xbits);
  244.                  SeperateBits(PelSize.Y, YBits);
  245.                  TempS := TempS + Chr(192 + (Xbits.P1 SHL 3) + YBits.P1) +
  246.                                   Chr(192 + (Xbits.P2 SHL 3) + YBits.P2) +
  247.                                   Chr(192 + (XBits.P3 SHL 3) + YBits.P3);
  248.               End;
  249.      End;
  250.      N_Domain := TempS;
  251. End;
  252.  
  253.  
  254. Function N_Reset (Color, Mode : Byte;
  255.                 D, T, F, U, X, M, R: Boolean) : String;
  256.                                                 {Color: 1..7, Mode 1..3    }
  257.                                                 {D - Domain  T - Text      }
  258.                                                 {F - Blink   U - User Fiels}
  259.                                                 {X - Texture M - Macros    }
  260.                                                 {R - DRCS                  }
  261. Begin
  262.      N_Reset := Chr(160) +
  263.               Chr(192 + (Color SHL 3) + (Mode SHL 1) + Ord(D)) +
  264.               Chr(192 + (Ord(R) SHL 5) + (Ord(M) SHL 4) + (Ord(X) SHL 3) +
  265.                         (ORD(U) SHL 2) + (Ord(F) SHL 1) + Ord(T));
  266. End;
  267.  
  268. Function N_Text (XSize, YSize: Byte) : String;
  269.  
  270. Var
  271.    XBits, YBits : NAPBits;
  272.  
  273. Begin
  274.      SeperateBits ( XSize, XBits);
  275.      SeperateBits ( YSize, YBits);
  276.      N_Text := Chr(162) +
  277.                Chr(192 + (CharSpace SHL 4) + (CharPath SHL 2) + CharRot) +
  278.                Chr(192 + (CursStyle SHL 4) + (MoveAttr SHL 2) + RowSpace) +
  279.                Chr(192 + (Xbits.P1 SHL 3) + YBits.P1) +
  280.                Chr(192 + (Xbits.P2 SHL 3) + YBits.P2) +
  281.                Chr(192 + (Xbits.P3 SHL 3) + YBits.P3);
  282. End;
  283.  
  284.  
  285.  
  286.  
  287.  
  288. Begin
  289.    Xcolor := 16;
  290.    LMO    := 3;
  291.    LSO    := 1;
  292.    PelSize.X := 1;
  293.    PelSize.Y := 1;
  294.    CharSpace := 0;
  295.    CharPath := 0;
  296.    CharRot := 0;
  297.    CursStyle := 0;
  298.    MoveAttr := 0;
  299.    RowSpace := 0;
  300. end.